home *** CD-ROM | disk | FTP | other *** search
Text File | 1990-03-27 | 43.5 KB | 1,767 lines | [TEXT/MPS ] |
- {$P}
- {[a-,body+,h-,o=100,r+,rec+,t=4,u+,#+,j=20/57/1$,n-]}
- { UMacApp.Globals.p }
- { Copyright © 1984-1990 by Apple Computer Inc. All rights reserved. }
-
- PROCEDURE InitializationThatMustNotFail;
- FORWARD;
-
- PROCEDURE DoInitUMacApp;
- FORWARD;
-
- {--------------------------------------------------------------------------------------------------}
- {$S MAGlobalsRes}
-
- PROCEDURE ApplicationBeep;
-
- BEGIN
- IF gApplication <> NIL THEN
- gApplication.Beep(2)
- ELSE
- SysBeep(2);
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S MAGlobalsRes}
-
- PROCEDURE CanPaste(aClipType: ResType);
-
- BEGIN
- IF gClipView <> NIL THEN
- IF gClipView.ContainsClipType(aClipType) THEN
- BEGIN
- gGotClipType := TRUE;
- gPrefClipType := aClipType;
- END;
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S MAGlobalsRes}
- {$Push} {$IFC qTrace} {$D+} {$EndC}
-
- PROCEDURE CleanupMacApp;
-
- VAR
- OldA5: LongInt;
-
- BEGIN
- OldA5 := SetCurrentA5; { ***** Called from trap patches *****}
-
- { Make sure segments can load }
- SetResLoad(TRUE);
- IF PermAllocation(FALSE) THEN;
-
- UnpatchTrap(pETSPatch); { Guaranteed not to fail }
-
- IF gApplication <> NIL THEN
- gApplication.Terminate;
-
- BusyRemove;
-
- {$IFC qDebug}
- DebugTerminate;
- {$ENDC}
-
- UnpatchAll;
-
- IF SetChooserAlert(gOldChooserFlag) THEN;
-
- OldA5 := SetA5(OldA5);
- END;
- {$Pop}
-
- {--------------------------------------------------------------------------------------------------}
- {$S MAGlobalsRes}
-
- PROCEDURE DoneViewRsrc(viewRsrc: UNIV Handle;
- lastPtr: UNIV LongInt);
-
- BEGIN
- HUnlock(viewRsrc);
- SetPermHandleSize(viewRsrc, StripLong(lastPtr) - StripLong(viewRsrc^));
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$IFC qDebug}
- {$S MADebug}
- {$Push} {$IFC qTrace} {$D+} {$ENDC}
-
- PROCEDURE DoneWithTempRgn;
- { Indicates that gTempRgn is no longer in use. Call this only if qDebug
- is true. }
-
- BEGIN
- IF NOT gBusyTempRgn THEN
- ProgramBreak('DoneWithTempRgn called, but gTempRgn is not locked');
- gBusyTempRgn := FALSE;
- gUsedBy := '';
- SetEmptyRgn(gTempRgn);
- END;
- {$Pop}
- {$ENDC}
-
- {--------------------------------------------------------------------------------------------------}
- {$IFC qDebug}
- {$S MADebug}
-
- PROCEDURE EntDebugger(entering: BOOLEAN);
-
- BEGIN
- BusyActivate(NOT entering);
- END;
- {$ENDC}
-
- {--------------------------------------------------------------------------------------------------}
- {$S MAError}
-
- PROCEDURE ErrorAlert(err: OSErr;
- message: LongInt);
-
- CONST
- kMsgCmdErr = msgCmdErr DIV $10000;
- kMsgAlert = msgAlert DIV $10000;
- kMsgLookup = msgLookup DIV $10000;
- kMsgAltRecov = msgAltRecovery DIV $10000;
-
- TYPE
- Converter = RECORD
- CASE BOOLEAN OF
- TRUE:
- (message: LongInt);
- FALSE:
- (hiWd, loWd: INTEGER);
- END;
-
- VAR
- c: Converter;
- alertID: INTEGER;
- genericAlert: BOOLEAN;
- opString: Str255;
- errStr: Str255;
- recovErr: OSErr;
- recovery: Str255;
- x: BOOLEAN;
-
- BEGIN
- c.message := message;
-
- alertID := phGenError; { the default alert }
- genericAlert := TRUE;
- opString := '';
-
- CASE c.hiWd OF
- kMsgCmdErr:
- BEGIN
- alertID := phCmdErr;
- CmdToName(c.loWd, opString);
- END;
- kMsgAlert:
- BEGIN
- alertID := c.loWd;
- genericAlert := FALSE;
- END;
- kMsgLookup, kMsgAltRecov:
- BEGIN
- x := LookupErrString(c.loWd, errOperationsID, opString);
- END;
- OTHERWISE
- BEGIN
- GetIndString(opString, c.hiWd, c.loWd);
- END;
- END;
-
- IF genericAlert THEN
- BEGIN
- x := LookupErrString(err, errReasonID, errStr);
-
- IF c.hiWd = kMsgAltRecov THEN
- recovErr := c.loWd
- ELSE
- recovErr := err;
-
- x := LookupErrString(recovErr, errRecoveryID, recovery);
-
- ParamText(errStr, recovery, opString, gErrorParm3);
-
- IF opString = '' THEN
- alertID := phUnknownErr;
- END;
-
- StdAlert(alertID);
- gInhibitNestedHandling := FALSE; { Used suppress nested event handling }
-
- IF genericAlert THEN
- ResetAlrtStage;
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S MATerminate}
-
- PROCEDURE ExitMacApp;
-
- BEGIN
- CleanupMacApp;
- ExitToShell;
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S MAGlobalsRes}
-
- FUNCTION ExpandPtr(viewRsrc: UNIV Handle;
- VAR p: UNIV LongInt;
- offset: LongInt): Ptr;
-
- VAR
- oldOffset: LongInt;
- rsrcSize: Size;
- desiredEnd: LongInt;
- rsrcBase: LongInt;
- currentPtr: LongInt;
-
- BEGIN
- rsrcSize := GetHandleSize(viewRsrc);
- rsrcBase := StripLong(viewRsrc^);
- currentPtr := StripLong(p);
- IF ODD(offset) THEN
- offset := offset + 1;
- desiredEnd := currentPtr + offset + SIZEOF(INTEGER);
-
- IF desiredEnd >= rsrcBase + rsrcSize THEN
- BEGIN
- { This appropriation logic might need some re-examination. If the size of the added
- template is larger than the minimum amount, then simply the size is added. If
- the handle is already near to being full, this won't help for the next allocation.
- Maybe it should use a hystersis?… }
- oldOffset := currentPtr - rsrcBase;
- HUnlock(viewRsrc);
- SetHandleSize(viewRsrc, rsrcSize + MAX(kViewRsrcExpandAmt, offset));
- FailMemError;
- LockHandleHigh(viewRsrc);
- p := LongInt(viewRsrc^) + oldOffset;
- END;
- ExpandPtr := Ptr(p);
- OffsetPtr(p, offset);
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S MAGlobalsRes}
-
- FUNCTION ExpandPtrWStr(viewRsrc: UNIV Handle;
- VAR p: UNIV LongInt;
- offset, len: LongInt): Ptr;
-
- BEGIN
- ExpandPtrWStr := ExpandPtr(viewRsrc, p, offset - 255 + len);
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S MAFinder}
- { This is a dummy procedure to allow us to find the Finder segment }
-
- PROCEDURE FinderSegProc;
-
- BEGIN
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S MAGlobalsRes}
-
- FUNCTION FreeIfWMgrWindow(w: WindowPtr;
- dispose: BOOLEAN): WindowPtr;
-
- BEGIN
- FreeIfWMgrWindow := NIL; { convenience to caller }
-
- IF w <> NIL THEN
- BEGIN
- IF dispose THEN
- BEGIN
- IF w = thePort THEN { Only need to invalidate focus if freed
- window is the current port }
- BEGIN
- IF gApplication <> NIL THEN
- gApplication.InvalidateFocus;
- SetPort(gWorkPort);
- END;
- DisposeWindow(w);
- END
- ELSE
- CloseWindow(w);
- END;
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S MAGlobalsRes}
-
- PROCEDURE FreeWMgrWindow(w: WindowPtr;
- dispose: BOOLEAN);
-
- BEGIN
- w := FreeIfWMgrWindow(w, dispose);
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S MAGlobalsRes}
-
- PROCEDURE GetFocus(VAR theFocusRec: FocusRec);
-
- BEGIN
- WITH theFocusRec DO
- BEGIN
- GetPort(Port);
- GetClip(Clip);
- Org := Port^.portRect.topLeft;
- LongOffset := gLongOffset;
- FocusedView := gFocusedView;
- printing := gPrinting;
- drawingPictScrap := gDrawingPictScrap;
- drawingPictScrapView := gDrawingPictScrapView;
- isValid := TRUE;
- END;
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S MAGlobalsRes}
-
- FUNCTION GetNewCenteredDialog(dialogID: INTEGER;
- dStorage: Ptr;
- behind: WindowPtr): DialogPtr;
-
- VAR
- dlogTemplate: DialogTHndl;
-
- BEGIN
- GetNewCenteredDialog := NIL;
- SetCursor(arrow);
- IF gApplication <> NIL THEN
- gApplication.InvalidateCursorRgn;
- dlogTemplate := DialogTHndl(GetResource('DLOG', dialogID));
- IF dlogTemplate <> NIL THEN
- BEGIN
- CenterRectOnScreen(dlogTemplate^^.boundsRect, TRUE, TRUE, TRUE);
- GetNewCenteredDialog := GetNewDialog(dialogID, dStorage, behind);
- END
- ELSE
- BEGIN
- SysBeep(2); { At least give some indication }
- {$IFC qDebug}
- ProgramBreak(ConcatNumber('Unable to find ‘DLOG’ resource ', dialogID));
- {$ENDC}
- END;
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S MAUtilitiesRes}{ Really a utility but, the gWorkPort isn't reachable from UMacAppUtilities }
-
- PROCEDURE GetTextStyleFontInfo(theTextStyle: TextStyle; VAR theFontInfo: FontInfo);
-
- VAR
- savedPort: GrafPtr;
-
- BEGIN
- GetPort(savedPort);
- SetPort(gWorkPort);
- SetPortTextStyle(theTextStyle);
- GetFontInfo(theFontInfo);
- SetPort(savedPort);
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S MAGlobalsRes} { Must be in a resident segment so that
- UnloadAllSegments doesn't unload it. }
-
- PROCEDURE HdlInitFailed(error: OSErr;
- message: LongInt);
-
- BEGIN
- UnloadAllSegments;
-
- IF error <> noErr THEN { check to see if an alert has already been
- displayed }
- BEGIN
- IF message = 0 THEN
- message := msgInitFailed; { if no message specified, use our own }
-
- ErrorAlert(error, message);
-
- ExitToShell;
- END;
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$Push}
- {$MC68020-} { Must be universal code }
- {$S Main}
- { Essential one-time initialization }
-
- PROCEDURE InitUMacApp(callsToMoreMasters: INTEGER);
- { Must be in the Main segment since all other segments get unloaded from here.}
-
- VAR
- initSeg: INTEGER;
- applZone: THz;
- oldMoreMast: INTEGER;
-
- PROCEDURE HdlInitUMacApp(error: OSErr;
- message: LongInt);
-
- BEGIN
- { try to make a little extra room. }
- UnloadSeg(@InitializationThatMustNotFail);
-
- IF error <> noErr THEN { check to see if an alert has already been
- displayed }
- BEGIN
- IF message = 0 THEN
- message := msgInitFailed; { if no message specified, use our own }
-
- {$IFC qDebug}
- UnloadSeg(@PLFlush);
- {$ENDC}
-
- ErrorAlert(error, message);
-
- ExitToShell;
- END;
- END;
-
- BEGIN
- IF NOT gToolboxInitialized THEN
- InitToolbox;
-
- IF ValidateConfiguration(gConfiguration) THEN { Make sure we can run. The programmer really
- should have ensured this in their "M" file but
- this is a backup check just in case. After
- all 68000's don't really like to RTD.}
- BEGIN
- InitializationThatMustNotFail;
-
- CatchFailures(pFi, HdlInitUMacApp);
- InitUMemory;
-
- { Install Outermost failure handler }
- Success(pFi);
- CatchFailures(pFi, HdlInitFailed);
-
- UnloadAllSegments;
-
- { Here is a trick sugested by Jerome C.--it allocates one large block of master pointers
- ??? Its cute, but will it eventually break? }
- applZone := ApplicZone;
- oldMoreMast := applZone^.moreMast;
- applZone^.moreMast := oldMoreMast * callsToMoreMasters;
- MoreMasters;
- applZone^.moreMast := oldMoreMast;
-
- LoadResidentSegments;
-
- InitUObject; { Initialize runtime support for objects }
-
- {$IFC qInspector}
- InitUInspector;
- {$ENDC}
-
- { Force the init segment to be memory resident, so we can call UnloadAllSegs during init }
- initSeg := GetSegNumber(@DoInitUMacApp);
- SetResidentSegment(initSeg, TRUE);
-
- DoInitUMacApp; { do rest of initialization }
-
- SetResidentSegment(initSeg, FALSE); { make it non-resident }
- UnloadAllSegments;
- END
- ELSE
- BEGIN
- StdAlert(phUnsupportedConfiguration);
- ExitToShell;
- END;
- END;
- {$Pop}
-
- {--------------------------------------------------------------------------------------------------}
- {$S MAMiniInit} { Must be in MAMiniInit }
-
- PROCEDURE ClearTheFPU;
- INLINE $42A7, { CLR.L -(A7) }
- $42A7, { CLR.L -(A7) }
- $F21F, $9800; { FMOVEM (A7)+, FPCR/FPSR }
-
- PROCEDURE InitializationThatMustNotFail;
- { Nothing in this routine can fail. }
-
- BEGIN
- { the main procedure is always compiled with universal code so, the FPU must be reset before it
- is used. We could get spurious crashes or worse.
-
- Remember: 2+2=4… every time!
- }
- IF qNeedsFPU | gConfiguration.hasFPU THEN
- ClearTheFPU;
-
- InitUPatch;
-
- {$IFC qDebug}
- gExperimenting := FALSE;
- gDebugPrinting := FALSE;
- gReportMenuChoices := FALSE;
- gIntenseDebugging := FALSE;
- gReportEvt := FALSE;
- gMastReport := FALSE;
- gRsrcReport := FALSE;
- gMemMgtBreak := FALSE;
- {$ENDC}
-
- { the following set up is necessary to call CleanupMacApp }
- gApplication := NIL;
-
-
- gMacAppAlertFilter := NIL;
-
- { !!! The alert filter is pretty good but… its new enough, and changes behaviour enough that
- we are more comfortable NOT installing it by default in this release (2.0). If you wish
- to use it and are not using the qExperimentalAndUnsupported flag then just assign its address
- into gMacAppAlertFilter in you IYourApplication method. }
-
- {$IFC qExperimentalAndUnsupported}
- gMacAppAlertFilter := @MacAppAlertFilter;
- {$EndC}
-
- gInFilter := FALSE;
- gInhibitNestedHandling := FALSE; { Allow nested handling }
-
- {$IFC qExperimentalAndUnsupported}
- gEnableDoubleBuffering := TRUE;
- {$EndC}
-
- FailNil(gCursorRgn);
- END;
- {--------------------------------------------------------------------------------------------------}
- {$S MAInit} { Must be in the init segment; unloaded at
- start of event loop }
-
- PROCEDURE DoInitUMacApp;
-
- VAR
- message: INTEGER;
- {$IFC qDebug}
- gDebugKeyMap: KeyMap; { the key state at start-up time }
- {$ENDC}
- fontSize, fontNum: INTEGER;
-
- BEGIN
- InitUBusyCursor;
- FailOsErr(HeadPatch(pETSPatch, _ExitToShell, @CleanupMacApp));
- BusyInstall;
-
- gAlwaysTrackCursor := FALSE;
-
- gMainEventMask := everyEvent;
-
- pCopyright := NewString(kCopyright);
-
- {$IFC qDebug}
- gRsrcCheck := kRsrcCheckInterval;
- gAssumeFocused := TRUE; { make TView.AssumeFocused actually check
- focus }
- {$ENDC}
-
- { Other 1-time initialization }
- gTempRgn := MakeNewRgn;
- gSaveFocusRec.Clip := MakeNewRgn;
-
- gClickCount := 0;
- gLastUpTime := TickCount;
- gLastClickPart := inDesk;
- gIdlePhase := idleEnd;
- gInBackground := FALSE; { When we start an app, it's in foreground }
- gLastDeskAcc := gLastUpTime;
-
- gWResSignature := kNoIdentifier;
- gWResType := '';
-
- { Create a work port for our convenience }
- gWorkPort := @gFakeWindow;
- IF qNeedsColorQD | gConfiguration.hasColorQD THEN
- OpenCPort(CGrafPtr(gWorkPort))
- ELSE
- OpenPort(gWorkPort);
-
- gFakeWindow.ControlList := NIL;
-
- gNextSpaceMsg := gLastUpTime;
- gLowSpaceInterval := kLowSpaceInterval;
-
- {$IFC qDebug}
- gBusyTempRgn := FALSE;
- gUsedBy := '';
- {$ENDC}
-
- gNoChanges := NIL; { Left in for compatibility (2.0) }
- gStdHysteresis := Point($00040004); { ??? any better choice ??? }
-
- SetPt(gZeroPt, 0, 0);
- SetRect(gZeroRect, 0, 0, 0, 0);
- SetVPt(gZeroVPt, 0, 0);
- SetVRect(gZeroVRect, 0, 0, 0, 0);
-
- WITH GetGrayRgn^^.rgnBBox DO
- BEGIN
- SetRect(gStdWMoveBounds, left + 4, top + 4, right - 4, bottom - 4);
-
- { arbitrary minimum size; maximum size is grayRgn size minus half the title bar }
- SetRect(gStdWSizeRect, 80, 80, right, bottom - 8 { half a title bar } );
-
- SetRect(gStdWScreenRect, left + 16, top + 16, right - 16, bottom - 16);
- END;
-
- gOrthogonal[v] := h;
- gOrthogonal[h] := v;
-
- gPrinting := FALSE;
- gCurrPrintHandler := NIL;
- gDrawingPictScrap := FALSE;
- gDrawingPictScrapView := NIL;
-
- gFinderPrinting := FALSE;
- gCouldPrint := FALSE;
-
- CountAppFiles(message, gFileCount);
- gFinderPrinting := (message = appPrint);
-
- gHeadCohandler := NIL;
- gEventLevel := 1; { Prevents UnloadAllSegs from getting called
- if a modal dialogs is used befure starting
- the main event loop }
-
- New(gNullPrintHandler);
- FailNil(gNullPrintHandler);
- gNullPrintHandler.IPrintHandler(NIL);
-
- gPrintHandler := gNullPrintHandler;
-
- gFreeWindowList := NewList;
-
- {$IFC qDebug}
- gFreeWindowList.SetEltType('TWindow');
- {$ENDC}
-
- gChooserOK := TRUE;
-
- gClipWindow := NIL;
-
- gGotClipType := FALSE;
-
- gClipView := NIL;
- gClipUndoView := NIL;
-
- gNumUntitled := 1; { call the first document Untitled-1 }
-
- gUndoState := kShowUndo;
- gUndoCmd := cNoCommand;
- gErrorParm3 := '';
- gFocusedView := NIL;
- gStdStaggerCount := 0;
-
- gMBarDisplayed := kMBarDisplayed;
- gMBarNotDisplayed := kMBarNotDisplayed;
- gMBarHierarchical := kMBarHierarchical;
-
- { Compute the system font size, to be stuffed into gSystemStyle… }
-
- IF qNeedsScriptManager | gConfiguration.hasScriptManager THEN
- fontSize := GetDefFontSize
- ELSE IF qNeedsROM128K | gConfiguration.hasROM128K THEN
- fontSize := IntegerPtr(kLMSysFontSize)^
- ELSE
- fontSize := 12; { Guess }
- SetTextStyle(gSystemStyle, systemFont, [], fontSize, gRGBBlack);
-
- SetTextStyle(gApplicationStyle, applFont, [], 0, gRGBBlack);
-
- gOldChooserFlag := SetChooserAlert(FALSE);
-
- gSignatureCount := 0;
-
- IF qTemplateViews THEN
- BEGIN
- { =============================================== }
- { Suppress Linker dead stripping of these classes }
-
- IF gDeadStripSuppression THEN
- BEGIN
- IF Member(TObject(NIL), TView) THEN;
- IF Member(TObject(NIL), TWindow) THEN;
- IF Member(TObject(NIL), TScrollBar) THEN;
- IF Member(TObject(NIL), TSScrollBar) THEN;
- IF Member(TObject(NIL), TScroller) THEN;
- IF Member(TObject(NIL), TDeskScrapView) THEN;
-
- IF Member(TObject(NIL), TDocument) THEN;
- IF Member(TObject(NIL), TNoChangesCommand) THEN;
- IF Member(TObject(NIL), TList) THEN;
- END;
- { =============================================== }
-
- RegisterStdType('TView', kStdView);
- RegisterStdType('TView', kStdDefaultView);
- RegisterStdType('TWindow', kStdWindow);
- RegisterStdType('TSScrollBar', kStdSScrollBar);
- RegisterStdType('TScroller', kStdScroller);
-
- RegisterStdType('TDocument', kStdDocument);
- RegisterStdType('TNoChangesCommand', kStdTracker);
- RegisterStdType('TList', kStdList);
- END;
-
- {$IFC qDebug}
- gTraceSetupMenus := FALSE;
- gTraceIdle := FALSE;
- InitUDebug(NIL, NIL, @EntDebugger, @InspectObject,
- @LookupSymbol);
-
- IF TrcEnable(TRUE) THEN; { Discard Result }
- {$ENDC}
-
- InitUMenuSetup;
-
- {$IFC qDebug}
- IF cUndo - cEditBase <> kSysUndo THEN
- WriteLn('Invalid UNDO command number');
- IF cCut - cEditBase <> kSysCut THEN
- WriteLn('Invalid CUT command number');
- IF cCopy - cEditBase <> kSysCopy THEN
- WriteLn('Invalid COPY command number');
- IF cPaste - cEditBase <> kSysPaste THEN
- WriteLn('Invalid PASTE command number');
- IF cClear - cEditBase <> kSysClear THEN
- WriteLn('Invalid CLEAR command number');
- {$ENDC}
-
- {$IFC qDebug}
- GetKeys(gDebugKeyMap);
- IF gDebugKeyMap[55] & gDebugKeyMap[56] & gDebugKeyMap[58] THEN { cmd-shift-option }
- ProgramBreak('At start of application');
- {$ENDC}
-
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S MARes}
-
- PROCEDURE InstallIfPrintHandler(aPrintHandler: TPrintHandler; aView: TView);
-
- VAR
- aNewPrintHandler: TPrintHandler;
-
- BEGIN
- IF (aPrintHandler <> gNullPrintHandler) & (gPrintHandler <> gNullPrintHandler) &
- (aPrintHandler <> NIL) & (aView <> NIL) THEN
- BEGIN
- aNewPrintHandler := TPrintHandler(aPrintHandler.clone);
- IF aPrintHandler <> NIL THEN
- BEGIN
- IF aView.fDocument <> NIL THEN
- BEGIN
- aView.fDocument.fDocPrintHandler := aNewPrintHandler;
- aNewPrintHandler.fDocument := aView.fDocument;
- END;
- aNewPrintHandler.fView := aView;
- aNewPrintHandler.SetDefaultPrintInfo;
- aView.AttachPrintHandler(aNewPrintHandler);
- END;
- END;
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S MAError}
-
- FUNCTION LookupErrString(value: INTEGER;
- resourceID: INTEGER;
- VAR str: Str255): BOOLEAN;
-
- FUNCTION SearchTable(value: INTEGER;
- resourceID: INTEGER;
- VAR str: Str255): BOOLEAN;
-
- LABEL 1;
-
- TYPE
- ErrRecordHandle = ^ErrRecord;
- ErrRecord = RECORD
- lowErr, highErr, index: INTEGER;
- END;
-
- VAR
- table: Handle;
- pEntry: ErrRecordHandle;
- tableOffset: LongInt;
- lenTab: INTEGER;
- strID: INTEGER;
- i: INTEGER;
-
- BEGIN
- SearchTable := FALSE;
- str := '';
-
- table := GetResource('errs', resourceID);
- IF table <> NIL THEN
- BEGIN
- lenTab := GetHandleSize(Handle(table)) DIV SIZEOF(ErrRecord);
-
- strID := 0;
- tableOffset := 0;
-
- FOR i := 1 TO lenTab DO
- BEGIN
- pEntry := ErrRecordHandle(Ord4(table^) + tableOffset);
-
- WITH pEntry^ DO
- BEGIN
- IF lowErr = 0 THEN
- strID := index
- ELSE IF (lowErr <= value) & (value <= highErr) THEN
- BEGIN
- IF index > 0 THEN
- GetIndString(str, strID, index);
- SearchTable := TRUE;
- GOTO 1; { exit the loop }
- END;
- END;
-
- tableOffset := tableOffset + SIZEOF(ErrRecord);
- END;
- 1:
- END;
- END;
-
- BEGIN
- IF SearchTable(value, errAppTable + resourceID, str) THEN
- LookupErrString := TRUE
- ELSE
- LookupErrString := SearchTable(value, resourceID, str);
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S MADebug}
-
- FUNCTION LookupSymbol(VAR sym: Str255): LongInt;
-
- BEGIN
- IF gInitialized THEN
- LookupSymbol := gTarget.LookupSymbol(sym)
- ELSE
- LookupSymbol := - 1;
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S MAGlobalsRes} { Don't require a segment load for this }
-
- VAR
- bufferString: String8; { If any script has a character with more
- than 8 bytes then the creatures that speak
- that language have too many fingers! }
-
- FUNCTION MacAppAlertFilter(theDialog: DialogPtr;
- VAR theEvent: EventRecord;
- VAR itemHit: INTEGER): BOOLEAN;
-
- { MacAppAlertFilter is a default filterProc used by MacAppAlert if the filterProc passed in is NIL.
- It maps key strokes to the first character of button item titles. It also hands off activate
- and update processing to gApplication if we're not being called from an error condition or
- while nested. }
-
- LABEL 1000;
-
- VAR
- theChar: CHAR;
- itemType: INTEGER;
- item: Handle;
- box: Rect;
- byteType: INTEGER;
- fi: FailInfo;
- oldInFilterState: BOOLEAN;
- anEvent: EventRecord;
-
- PROCEDURE HdlFilter(error: INTEGER;
- message: LongInt);
-
- BEGIN
- GOTO 1000;
- END;
-
- FUNCTION GetButtonTitle(itemNo: INTEGER): String8;
- { Retrieve the title of the button control.
- If itemNo isn't a button, then return ''. }
-
- VAR
- title: Str255;
-
- BEGIN
- GetDItem(theDialog, itemNo, itemType, item, box);
- IF itemType <> (ctrlItem + btnCtrl) THEN
- title := ''
- ELSE
- GetCTitle(ControlHandle(item), title);
- GetButtonTitle := title;
- END;
-
- PROCEDURE DoKeyDown(itemNo: INTEGER);
- { Handle a keypress that has been mapped to one of the button controls. }
-
- VAR
- finalTicks: LongInt;
-
- BEGIN
- MacAppAlertFilter := TRUE;
- itemHit := itemNo;
- GetDItem(theDialog, itemNo, itemType, item, box);
- IF itemType = (ctrlItem + btnCtrl) THEN
- BEGIN { this code gives visual feedback }
- HiliteControl(ControlHandle(item), inButton); { hilite the button }
- Delay(8, finalTicks); { delay for 8 ticks }
- HiliteControl(ControlHandle(item), 0); { stop hiliting the button }
- END;
- END;
-
- FUNCTION TestAString(aString: String8): BOOLEAN;
- { in the case of Script Manager systems, use CharByte to determine character boundaries
- and compare the input to the button titles }
-
- VAR
- textOffset: INTEGER;
- done, areEqual: BOOLEAN;
-
- BEGIN
- textOffset := 0;
- done := FALSE;
- REPEAT
- IF qNeedsScriptManager | gConfiguration.hasScriptManager THEN
- byteType := CharByte(@aString[1], textOffset) { textOffset is zero-based }
- ELSE
- byteType := smSingleByte;
-
- textOffset := textOffset + 1;
- areEqual := aString[textOffset] = bufferString[textOffset];
- CASE byteType OF
- smSingleByte:
- BEGIN { special case single byte characters to
- allow lower case characters to map to
- upper case characters }
- areEqual := LowerChar(aString[1]) = LowerChar(bufferString[1]);
- done := TRUE;
- END;
- smFirstByte:
- done := NOT areEqual; { we're done if they don't match }
- smLastByte:
- done := TRUE;
- smMiddleByte:
- done := NOT areEqual; { we're done if they don't match }
- END;
- UNTIL done;
- TestAString := areEqual;
- END;
-
- PROCEDURE DoAddByte(theChar: CHAR);
- { adds the incoming byte to the bufferString of typed characters }
-
- VAR
- buffIndex: INTEGER;
-
- BEGIN
- buffIndex := ORD(bufferString[0]) + 1; { increment count }
- bufferString[buffIndex] := theChar; { assign new character }
- bufferString[0] := CHR(buffIndex); { assign length byte }
- END;
-
- PROCEDURE DoLastByte(theChar: CHAR);
- { adds the last incoming byte to the bufferString of typed characters
- and compares the bufferString to the first character of each button title
- 1st button in alert (by convention = "OK"). 2nd button in alert (by convention =
- "Cancel"). 3rd button in alert (by convention = "No") }
-
- BEGIN
- DoAddByte(theChar);
- IF TestAString(GetButtonTitle(ok)) THEN
- DoKeyDown(ok)
- ELSE IF TestAString(GetButtonTitle(cancel)) THEN
- DoKeyDown(cancel)
- ELSE IF TestAString(GetButtonTitle(kNoButton)) THEN
- DoKeyDown(kNoButton);
- bufferString := ''; { initialize bufferString }
- END;
-
- BEGIN { MacAppAlertFilter }
- MacAppAlertFilter := FALSE;
- oldInFilterState := gInFilter;
- gInFilter := TRUE;
- CatchFailures(fi, HdlFilter);
-
- { Wouldn't want MacApp to get lied to about where the focus _Actually_ is }
- IF (gApplication <> NIL) & NOT gInhibitNestedHandling & NOT oldInFilterState THEN
- gApplication.InvalidateFocus;
-
- CASE theEvent.what OF
- activateEvt: { this is the first event the alert gets, so
- let's determine our VARs }
- BEGIN
- IF DialogPtr(theEvent.message) = theDialog THEN
- BEGIN
- bufferString := ''; { initialize bufferString }
- END
- ELSE IF (gApplication <> NIL) & NOT gInhibitNestedHandling & NOT oldInFilterState THEN
- gApplication.HandleEvent(theEvent);
- END;
-
- updateEvt: { this is the first event the alert gets, so
- let's determine our VARs }
- BEGIN
- IF DialogPtr(theEvent.message) <> theDialog THEN
- IF (gApplication <> NIL) & NOT gInhibitNestedHandling & NOT oldInFilterState THEN
- gApplication.HandleEvent(theEvent);
- END;
- keyDown: { let's determine if the key pressed
- corresponds to our button titles }
- BEGIN
- theChar := CHR(BAND(theEvent.message, charCodeMask));
- IF qNeedsScriptManager | gConfiguration.hasScriptManager THEN
- byteType := CharByte(@theChar, 0)
- ELSE
- byteType := smLastByte; { punt...treat each byte as the last
- character }
- CASE byteType OF
- smSingleByte:
- IF (theChar = chEnter) | (theChar = chReturn) THEN
- DoKeyDown(ok)
- ELSE IF (theChar = chEscape) | ((theChar = '.') & (BAND(theEvent.modifiers,
- cmdKey) <> 0)) THEN
- DoKeyDown(cancel)
- ELSE
- DoLastByte(theChar);
- smFirstByte:
- DoAddByte(theChar);
- smLastByte:
- DoLastByte(theChar);
- smMiddleByte:
- DoAddByte(theChar);
- END; { CASE }
- END;
- END;
-
- { Idle but only if _REALLY_ necessary }
- IF (gApplication <> NIL) & NOT gInhibitNestedHandling & NOT oldInFilterState &
- NOT EventAvail(everyEvent, anEvent) THEN
- gApplication.Idle(gIdlePhase);
-
- Success(fi);
- 1000:
- gInFilter := oldInFilterState;
- END; { MacAppAlertFilter }
-
- {--------------------------------------------------------------------------------------------------}
- {$Push}
- {$MC68020-} { Need to be able to alert user if this
- isn't a 68020 machine, alert filter won't
- be installed until after that, though. }
- {$S MAGlobalsRes} { Don't require a segment load for this }
-
- FUNCTION MacAppAlert(alertID: INTEGER;
- filterProc: ProcPtr): INTEGER;
-
- VAR
- alrtTemplate: AlertTHndl;
-
- FUNCTION CanAlert:Boolean; { ensures that the Alert won't fail }
-
- BEGIN
- CouldAlert(alertID);
- CanAlert := (ResError = NoErr) & (MemError = NoErr);
- FreeAlert(alertID);
- END;
-
- BEGIN
- {$IFC qDebug}
- gRsrcCheck := 0; { force immediate check. }
- {$ENDC}
-
- SetCursor(arrow);
- alrtTemplate := AlertTHndl(GetResource('ALRT', alertID));
- IF alrtTemplate <> NIL THEN
- BEGIN
- IF GetResource('DITL', alertID) = NIL THEN { preflight the DITL }
- BEGIN { DITL is missing or not enough memory }
- {$IFC qDebug}
- ProgramBreak(ConcatNumber('Unable to find or load ‘DITL’ resource ', alertID));
- {$ENDC}
- SysBeep(2); { At least give some indication }
- MacAppAlert := 1; { Arbitrary result }
- END
- ELSE
- BEGIN
- IF NOT CanAlert THEN
- BEGIN { no can do }
- {$IFC qDebug}
- ProgramBreak(ConcatNumber('Unable to display alert ', alertID));
- {$ENDC}
- SysBeep(2); { At least give some indication }
- MacAppAlert := 1; { Arbitrary result }
- END
- ELSE
- BEGIN
- LockHandleHigh(Handle(alrtTemplate));
- CenterRectOnScreen(alrtTemplate^^.boundsRect, TRUE, TRUE, TRUE);
- PullApplicationToFront;
- IF (filterProc = NIL) THEN
- MacAppAlert := Alert(alertID, gMacAppAlertFilter)
- ELSE
- MacAppAlert := Alert(alertID, filterProc);
- END
- END
- END
- ELSE
- BEGIN
- {$IFC qDebug}
- ProgramBreak(ConcatNumber('Unable to find or load ‘ALRT’ resource ', alertID));
- {$ENDC}
- SysBeep(2); { At least give some indication }
- MacAppAlert := 1; { Arbitrary result }
- END;
-
- IF gApplication <> NIL THEN
- gApplication.InvalidateCursorRgn;
-
- InvalidateMenus;
- END;
- {$Pop}
-
- {--------------------------------------------------------------------------------------------------}
- {$S MAGlobalsRes}
-
- FUNCTION MakeNewRgn: RgnHandle;
-
- VAR
- aRgn: RgnHandle;
-
- BEGIN
- aRgn := NewRgn;
- FailNil(aRgn);
- MakeNewRgn := aRgn;
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S MAOpen}
-
- FUNCTION NewPaletteWindow(itsRsrcID: INTEGER;
- wantHScrollBar, wantVScrollBar: BOOLEAN;
- itsDocument: TDocument;
- itsMainView: TView;
- itsPaletteView: TView;
- sizePalette: INTEGER;
- whichWay: VHSelect): TWindow;
-
- VAR
- aWindow: TWindow;
- aScroller: TScroller;
- fi: FailInfo;
- itsSize: VPoint;
- itsLocation: VPoint;
- wSize: Point;
- sBarOffsets: VRect;
-
- PROCEDURE HdlNPWindow(error: INTEGER;
- message: LongInt);
-
- BEGIN
- FreeIfObject(aWindow);
- aWindow := NIL;
- END;
-
- BEGIN
- aWindow := NewTWindow(itsRsrcID, itsDocument);
-
- WITH aWindow.fResizeLimits.topLeft DO
- vh[whichWay] := vh[whichWay] + sizePalette;
-
- CatchFailures(fi, HdlNPWindow);
-
- aWindow.AddSubView(itsPaletteView);
-
- itsLocation := gZeroVPt;
- itsLocation.vh[whichWay] := sizePalette;
- IF wantHScrollBar | wantVScrollBar THEN
- BEGIN
- sBarOffsets := gZeroVRect;
- itsSize := aWindow.fSize;
- IF wantHScrollBar THEN
- BEGIN
- itsSize.v := itsSize.v - kSBarSizeMinus1;
- IF NOT wantVScrollBar THEN
- sBarOffsets.right := - kSBarSizeMinus1;
- END;
- IF wantVScrollBar THEN
- BEGIN
- itsSize.h := itsSize.h - kSBarSizeMinus1;
- IF NOT wantHScrollBar THEN
- sBarOffsets.bottom := - kSBarSizeMinus1;
- END;
- itsSize.vh[whichWay] := itsSize.vh[whichWay] - sizePalette;
- New(aScroller);
- FailNil(aScroller);
- aScroller.IScroller(aWindow, itsLocation, itsSize, sizeRelSuperView, sizeRelSuperView, 0, 0,
- wantHScrollBar, wantVScrollBar);
- aScroller.fSBarOffsets := sBarOffsets;
- aScroller.AddSubView(itsMainView);
- END
- ELSE
- aWindow.AddSubView(itsMainView);
-
- aWindow.SetTarget(itsMainView);
-
- { make frames be the right size }
- WITH aWindow.fWMgrWindow^.portRect DO
- BEGIN
- wSize := botRight;
- {$Push} {$H-}
- SubPt(topLeft, wSize);
- {$Pop}
- END;
- aWindow.Resize(wSize.h, wSize.v, kDontInvalidate);
-
- NewPaletteWindow := aWindow;
-
- Success(fi);
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S MAOpen}
-
- FUNCTION NewSimpleWindow(itsRsrcID: INTEGER;
- wantHScrollBar, wantVScrollBar: BOOLEAN;
- itsDocument: TDocument;
- itsView: TView): TWindow;
-
- VAR
- aWindow: TWindow;
- aScroller: TScroller;
- fi: FailInfo;
- itsSize: VPoint;
- wSize: Point;
- sBarOffsets: VRect;
-
- PROCEDURE HdlNSWindow(error: INTEGER;
- message: LongInt);
-
- BEGIN
- FreeIfObject(aWindow);
- aWindow := NIL;
- END;
-
- BEGIN
- aWindow := NewTWindow(itsRsrcID, itsDocument);
-
- aScroller := NIL;
-
- CatchFailures(fi, HdlNSWindow);
-
- IF wantHScrollBar | wantVScrollBar THEN
- BEGIN
- sBarOffsets := gZeroVRect;
- itsSize := aWindow.fSize;
- IF wantHScrollBar THEN
- BEGIN
- itsSize.v := itsSize.v - kSBarSizeMinus1;
- IF NOT wantVScrollBar THEN
- sBarOffsets.right := - kSBarSizeMinus1;
- END;
- IF wantVScrollBar THEN
- BEGIN
- itsSize.h := itsSize.h - kSBarSizeMinus1;
- IF NOT wantHScrollBar THEN
- sBarOffsets.bottom := - kSBarSizeMinus1;
- END;
- New(aScroller);
- FailNil(aScroller);
- aScroller.IScroller(aWindow, gZeroVPt, itsSize, sizeRelSuperView, sizeRelSuperView, 0, 0,
- wantHScrollBar, wantVScrollBar);
- aScroller.fSBarOffsets := sBarOffsets;
- IF itsView <> NIL THEN
- aScroller.AddSubView(itsView);
- END
- ELSE IF itsView <> NIL THEN
- aWindow.AddSubView(itsView);
-
- aWindow.SetTarget(itsView);
-
- { make sure window and subviews are the right size }
- WITH aWindow.fWMgrWindow^.portRect DO
- BEGIN
- wSize := botRight;
- {$Push} {$H-}
- SubPt(topLeft, wSize);
- {$Pop}
- END;
- aWindow.Resize(wSize.h, wSize.v, kDontInvalidate);
-
- NewSimpleWindow := aWindow;
-
- Success(fi);
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S MAOpen}
-
- FUNCTION NewStdObject(signature: IDType): TObject;
-
- VAR
- i: INTEGER;
- obj: TObject;
-
- BEGIN
- FOR i := 1 TO gSignatureCount DO
- IF LongInt(gSignatures[i]) = LongInt(signature) THEN
- BEGIN
- NewStdObject := NewObjectByClassId(gSignatureIds[i]);
- EXIT(NewStdObject);
- END;
-
- {$IFC qDebug}
- WriteLn('signature=‘', signature, '’');
- ProgramBreak('Unable to find class for the given signature');
- {$ENDC}
- NewStdObject := NIL;
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S MAOpen}
-
- FUNCTION NewTWindow(itsRsrcID: INTEGER;
- itsDocument: TDocument): TWindow;
-
- VAR
- aWMgrWindow: WindowPtr;
- aWindow: TWindow;
- canResize: BOOLEAN;
- canClose: BOOLEAN;
- fi: FailInfo;
-
- PROCEDURE HdlNewWObj(error: INTEGER;
- message: LongInt);
-
- BEGIN
- { the wmgrWindow is known to exist }
- { Since aWindow didn't get created, the wmgrWindow won't be
- freed unless we do it here. }
-
- aWMgrWindow := FreeIfWMgrWindow(aWMgrWindow, TRUE);
-
- END;
-
- BEGIN
- aWMgrWindow := NIL;
- aWMgrWindow := gApplication.GetRsrcWindow(NIL, itsRsrcID, canResize, canClose);
- { GetRsrcWindow signals Failure }
-
- CatchFailures(fi, HdlNewWObj);
-
- aWindow := NIL;
-
- New(aWindow);
- FailNil(aWindow);
- Success(fi);
-
- aWindow.IWindow(itsDocument, aWMgrWindow, canResize, canClose, TRUE); { TRUE means can dispose
- wmgr window }
-
- NewTWindow := aWindow;
-
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S MAOpen}
-
- FUNCTION NewTemplateWindow(viewRsrcID: INTEGER;
- itsDocument: TDocument): TWindow;
-
- VAR
- theWindow: TWindow;
- theTarget: TView;
- aView: TView;
-
- BEGIN
- theWindow := NIL;
-
- aView := gTarget.DoCreateViews(itsDocument, NIL, viewRsrcID, gZeroVPt);
- IF aView <> NIL THEN
- BEGIN
- IF qDebug & NOT MEMBER(aView, TWindow) THEN
- ProgramBreak('In NewTemplateWindow: Root view is not a window');
-
- theWindow := TWindow(aView);
-
- IF theWindow.fWMgrWindow <> NIL THEN
- WITH theWindow.fWMgrWindow^.portRect DO
- theWindow.Resize(right - left, bottom - top, kDontInvalidate);
- IF theWindow.fTargetID <> kNoIdentifier THEN
- BEGIN
- theTarget := theWindow.FindSubView(theWindow.fTargetID);
- IF theTarget <> NIL THEN
- theWindow.SetTarget(theTarget)
- ELSE IF qDebug THEN
- ProgramBreak('The window has no view whose id is fTargetId.');
- END;
- END;
- NewTemplateWindow := theWindow;
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S MAGlobalsRes}
-
- FUNCTION NewViewRsrc(VAR p: UNIV Ptr): ViewRsrcHndl;
-
- VAR
- aHandle: ViewRsrcHndl;
-
- BEGIN
- aHandle := ViewRsrcHndl(NewPermHandle(kViewRsrcExpandAmt));
- FailNil(aHandle);
- LockHandleHigh(Handle(aHandle));
- WITH aHandle^^ DO
- BEGIN
- numViews := 0;
- p := @theViews;
- END;
- NewViewRsrc := aHandle;
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S MADebug}
-
- PROCEDURE NotYetImplemented(where: Str255);
-
- BEGIN
- Failure(errNotImplemented, 0);
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S MAOpen}
-
- PROCEDURE OffsetPtr(VAR p: UNIV LongInt;
- offset: LongInt);
-
- BEGIN
- p := p + offset;
- IF ODD(p) THEN
- p := p + 1;
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S MAOpen}
-
- PROCEDURE OffsetPtrWStr(VAR p: UNIV LongInt;
- offset: LongInt);
-
- BEGIN
- OffsetPtr(p, offset - 255 + LENGTH(StringPtr(p + offset - 256)^));
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S MAGlobalsRes}
-
- FUNCTION ParseTitleTemplate(VAR itsTemplate: Str255;
- VAR preDocname, constTitle: INTEGER): BOOLEAN;
-
- CONST
- kPreDocname = '<<<';
- kPreSize = 3;
- kPostDocname = '>>>';
- kPostSize = 3;
-
- VAR
- x: INTEGER;
-
- FUNCTION FindPos(pattern: Str255;
- VAR source: Str255): INTEGER;
-
- VAR
- i, j: INTEGER;
- position: INTEGER;
-
- BEGIN
- IF qNeedsScriptManager | gConfiguration.hasScriptManager THEN
- BEGIN
- i := 0;
- REPEAT
- i := i + 1;
- position := i;
- FOR j := 1 TO LENGTH(pattern) DO
- IF NOT ((source[i + j - 1] = pattern[j]) & (CharByte(@source, i + j) = 0)) THEN
- BEGIN
- position := 0;
- LEAVE;
- END;
- UNTIL (position > 0) | (i >= LENGTH(source) - LENGTH(pattern) + 1);
- END
- ELSE
- position := POS(pattern, source);
-
- FindPos := position;
- END;
-
- BEGIN
- IF itsTemplate = '' THEN
- BEGIN
- preDocname := 1;
- constTitle := 0;
- END
- ELSE
- BEGIN
- preDocname := FindPos(kPreDocname, itsTemplate);
- IF preDocname > 0 THEN
- BEGIN
- Delete(itsTemplate, preDocname, kPreSize);
-
- x := FindPos(kPostDocname, itsTemplate);
- IF x = 0 THEN
- constTitle := preDocname - 1
- ELSE
- BEGIN
- Delete(itsTemplate, x, kPostSize);
- constTitle := LENGTH(itsTemplate) - x + preDocname;
- END;
- END;
- END;
-
- ParseTitleTemplate := preDocname > 0;
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S MAGlobalsRes}
-
- FUNCTION PtIsVisible(pt: Point): BOOLEAN;
-
- BEGIN
- IF gDrawingPictScrap THEN
- PtIsVisible := TRUE
- ELSE
- PtIsVisible := PtInRgn(pt, thePort^.visRgn) & PtInRgn(pt, thePort^.clipRgn);
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S MAActivate}
-
- FUNCTION PutDeskScrapData(aResType: ResType;
- aDataHandle: Handle): OSErr;
-
- VAR
- err: LongInt;
-
- BEGIN
- LockHandleHigh(aDataHandle);
- err := PutScrap(GetHandleSize(aDataHandle), aResType, aDataHandle^);
- HUnlock(aDataHandle);
- {$IFC qDebug}
- IF err <> noErr THEN
- WriteLn('Error from PutScrap is: ', err: 1);
- {$ENDC}
- PutDeskScrapData := err;
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S MAGlobalsRes}
-
- FUNCTION RectIsVisible(r: Rect): BOOLEAN;
-
- BEGIN
- IF gDrawingPictScrap THEN
- RectIsVisible := TRUE
- ELSE
- RectIsVisible := RectInRgn(r, thePort^.visRgn) & RectInRgn(r, thePort^.clipRgn);
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S MAGlobalsRes}
-
- PROCEDURE RegisterStdType(typeName: Str255;
- signature: IDType);
- { Register or re-register a type and a class }
-
- VAR
- i: INTEGER;
-
- BEGIN
- { try to find an existing signature to replace }
- FOR i := 1 TO gSignatureCount DO
- IF LongInt(gSignatures[i]) = LongInt(signature) THEN
- BEGIN
- gSignatureIds[i] := GetClassIDFromName(typeName);
- { If the name can't be found it was probably misspelled or dead-stripped }
- IF gSignatureIds[i] = kNilClass THEN
- Failure(minErr, 0); {??? need to assign a message???}
- EXIT(RegisterStdType);
- END;
-
- { not found to replace… add a new one }
- gSignatureCount := gSignatureCount + 1;
- {$IFC qDebug}
- IF gSignatureCount >= kMaxSignatures THEN
- ProgramBreak('Maximum number of signatures exceeded.');
- {$ENDC}
- gSignatures[gSignatureCount] := signature;
- gSignatureIds[gSignatureCount] := GetClassIDFromName(typeName);
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S MAGlobalsRes}
-
- PROCEDURE SetFocus(theFocusRec: FocusRec);
-
- BEGIN
- WITH theFocusRec DO
- BEGIN
- SetPort(Port);
- SetOrigin(Org.h, Org.v);
- SetClip(Clip);
- gLongOffset := LongOffset;
- gFocusedView := FocusedView;
- gPrinting := printing;
- gDrawingPictScrap := drawingPictScrap;
- gDrawingPictScrapView := drawingPictScrapView;
- END;
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S MAGlobalsRes}
-
- PROCEDURE SetHLPenState(fromHL, toHL: HLState);
-
- VAR
- pPat: ^pattern;
- mode: INTEGER;
-
- BEGIN
- mode := patXOR; { every transition except hlOn <-> hlDim
- uses patXOR }
-
- IF fromHL = toHL THEN
- pPat := @white
-
- ELSE IF fromHL + toHL = hlOffOn THEN
- pPat := @black
-
- ELSE
- pPat := @gray; { ??? make this pattern a parameter ??? }
-
- IF fromHL + toHL = hlDimOn THEN
- mode := NOTpatXOR;
-
- PenMode(mode);
- PenPat(pPat^);
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$Push}
- {$MC68020-} { Need to be able to alert user if this
- isn't a 68020 machine }
- {$S MAGlobalsRes} { Don't require a segment load for this }
-
- PROCEDURE StdAlert(alertID: INTEGER);
-
- VAR
- reply: INTEGER;
-
- BEGIN
- reply := MacAppAlert(alertID, NIL);
- END;
- {$Pop}
-
- {--------------------------------------------------------------------------------------------------}
- {$S MAGlobalsRes}
-
- FUNCTION SubstituteInTitle(VAR title: Str255;
- newStuff: Str255;
- preDocname, constTitle: INTEGER): BOOLEAN;
-
- BEGIN
- IF preDocname > 0 THEN
- BEGIN
- IF constTitle = 0 THEN
- title := newStuff
- ELSE
- BEGIN
- Delete(title, preDocname, LENGTH(title) - constTitle);
- Insert(newStuff, title, preDocname);
- END;
- SubstituteInTitle := TRUE;
- END
- ELSE
- SubstituteInTitle := FALSE;
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$IFC qDebug}
- {$S MADebug}
- {$Push} {$IFC qTrace} {$D+} {$ENDC}
-
- PROCEDURE UseTempRgn(byWhom: Str255);
- { Call this when you are about to use gTempRgn and qDebug is true. Used
- with DoneWithTempRgn will prevent you from trying to use gTempRgn
- from two places at the same time. }
-
- BEGIN
- IF gBusyTempRgn THEN
- BEGIN
- WriteLn('"', byWhom, '" is trying to lock gTempRgn,');
- WriteLn('but it is already locked by "', gUsedBy, '"');
- ProgramBreak('Error in UseTempRgn');
- END
- ELSE
- BEGIN
- gBusyTempRgn := TRUE;
- gUsedBy := byWhom;
- END;
- END;
- {$Pop}
- {$ENDC qDebug}
-
- {--------------------------------------------------------------------------------------------------}
- {$S MAGlobalsRes}
-
- PROCEDURE VisibleRect(VAR r: Rect);
-
- BEGIN
- IF NOT gDrawingPictScrap THEN
- BEGIN
- {$IFC qDebug}
- UseTempRgn('VisibleRect');
- {$ENDC}
- RectRgn(gTempRgn, r);
-
- { Some print drivers don't set the visRgn correctly.
- ??? Shouldn't this really be accounted for in printhandler code }
- IF NOT gPrinting THEN
- SectRgn(gTempRgn, thePort^.visRgn, gTempRgn);
- SectRgn(gTempRgn, thePort^.clipRgn, gTempRgn);
- r := gTempRgn^^.rgnBBox;
- {$IFC qDebug}
- DoneWithTempRgn;
- {$ENDC}
- END;
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$IFC qDebug}
- {$S MADebug}
-
- PROCEDURE WriteFocus;
-
- BEGIN
- WrLblVPt(' gLongOffset', gLongOffset);
- WriteLn;
- WrLblRect(' portRect', thePort^.portRect);
- WriteLn;
- WrLblRect(' visRgn', thePort^.visRgn^^.rgnBBox);
- WriteLn;
- WrLblRect(' clipRgn', thePort^.clipRgn^^.rgnBBox);
- WriteLn;
- END;
- {$ENDC}
-